ExtractBorderInteger Subroutine

private subroutine ExtractBorderInteger(grid, border, cardinal)

Extracts only the cells on the external border. Other cells are assigned nodata. Border cell is the one that has at least a nodata value in the neighbouring 8 cells. If cardinal is passed the routine checks only the four cells in the cardinal direction. This option is used to obtain border without duplicates. Default is check all the cells.

Arguments

Type IntentOptional Attributes Name
type(grid_integer), intent(in) :: grid
type(grid_integer), intent(out) :: border
logical, intent(in), optional :: cardinal

Variables

Type Visibility Attributes Name Initial
integer, public :: col
logical, public :: foundNodata
logical, public :: fourCells

true if to consider only four cells in cardinal directions
integer, public :: i
integer, public :: j
integer, public :: row

Source Code

SUBROUTINE ExtractBorderInteger &
!
(grid, border, cardinal) 

IMPLICIT NONE

!Arguments with intent in:
TYPE (grid_integer), INTENT(IN) :: grid
LOGICAL, INTENT(IN), OPTIONAL :: cardinal

!Arguments with intent out:
TYPE (grid_integer), INTENT(OUT) :: border

!Local declaration:

INTEGER :: i,j
LOGICAL :: foundNodata
INTEGER :: row, col
LOGICAL :: fourCells !!true if to consider only four cells in cardinal directions

!---------------------------end of declarations--------------------------------

!Allocate space for grid containing values on the border
CALL NewGrid (border, grid)

IF (PRESENT(cardinal)) THEN
  IF (cardinal) THEN
    fourCells = .TRUE.
  ELSE
    fourCells = .FALSE.
  END IF
ELSE
  fourCells = .FALSE.
END IF

!scan grid
DO i = 1, border % idim
  DO j = 1, border % jdim
    IF (grid % mat (i,j) /= grid % nodata) THEN

          foundNodata = .FALSE.
          
          !check EAST cell
          row = i 
          col = j + 1
          IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
            IF (grid % mat (row,col) == grid % nodata) THEN
               foundNodata = .TRUE.
               border % mat (i,j) = grid % mat (i,j)
               CYCLE
            END IF
          ELSE
            foundNodata = .TRUE.
            border % mat (i,j) = grid % mat (i,j)
            CYCLE
          END IF
          
          !check SOUTH-EAST cell
          IF ( .NOT. fourCells) THEN
              row = i + 1
              col = j + 1
              IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
                IF (grid % mat (row,col) == grid % nodata) THEN
                   foundNodata = .TRUE.
                   border % mat (i,j) = grid % mat (i,j)
                   CYCLE
                END IF
              ELSE
                foundNodata = .TRUE.
                border % mat (i,j) = grid % mat (i,j)
                CYCLE
              END IF
          END IF
          !check SOUTH cell
          row = i + 1
          col = j
          IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
            IF (grid % mat (row,col) == grid % nodata) THEN
               foundNodata = .TRUE.
               border % mat (i,j) = grid % mat (i,j)
               CYCLE
            END IF
          ELSE
            foundNodata = .TRUE.
            border % mat (i,j) = grid % mat (i,j)
            CYCLE
          END IF
          
          !check SOUTH-WEST cell
          IF (.NOT. fourCells) THEN
              row = i + 1
              col = j - 1
              IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
                IF (grid % mat (row,col) == grid % nodata) THEN
                   foundNodata = .TRUE.
                   border % mat (i,j) = grid % mat (i,j)
                   CYCLE
                END IF
              ELSE
                foundNodata = .TRUE.
                border % mat (i,j) = grid % mat (i,j)
                CYCLE
              END IF
          END IF
          
          !check WEST cell
          row = i 
          col = j - 1
          IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
            IF (grid % mat (row,col) == grid % nodata) THEN
               foundNodata = .TRUE.
               border % mat (i,j) = grid % mat (i,j)
               CYCLE
            END IF
          ELSE
            foundNodata = .TRUE.
            border % mat (i,j) = grid % mat (i,j)
            CYCLE
          END IF
          
          !check NORTH-EAST cell
          IF (.NOT. fourCells) THEN
              row = i - 1
              col = j - 1
              IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
                IF (grid % mat (row,col) == grid % nodata) THEN
                   foundNodata = .TRUE.
                   border % mat (i,j) = grid % mat (i,j)
                   CYCLE
                END IF
              ELSE
                foundNodata = .TRUE.
                border % mat (i,j) = grid % mat (i,j)
                CYCLE
              END IF
          END IF
          
          !check NORTH cell
          row = i - 1
          col = j
          IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
            IF (grid % mat (row,col) == grid % nodata) THEN
               foundNodata = .TRUE.
               border % mat (i,j) = grid % mat (i,j)
               CYCLE
            END IF
          ELSE
            foundNodata = .TRUE.
            border % mat (i,j) = grid % mat (i,j)
            CYCLE
          END IF
          
          !check NORTH-EAST cell
          IF (.NOT. fourCells) THEN
              row = i - 1
              col = j + 1
              IF ( .NOT. IsOutOfGrid(row,col,border) ) THEN
                IF (grid % mat (row,col) == grid % nodata) THEN
                   foundNodata = .TRUE.
                   border % mat (i,j) = grid % mat (i,j)
                   CYCLE
                END IF
              ELSE
                foundNodata = .TRUE.
                border % mat (i,j) = grid % mat (i,j)
                CYCLE
              END IF
          END IF
          
          IF ( .NOT. foundNodata ) THEN
            border % mat (i,j) = border % nodata
          END IF
       
    END IF
  END DO
END DO

RETURN 


END SUBROUTINE ExtractBorderInteger